home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / ConvertAnimToGrey.AMOS / ConvertAnimToGrey.amosSourceCode < prev   
AMOS Source Code  |  1997-04-15  |  1KB  |  51 lines
  1. ' *********************************
  2. ' *                               *
  3. ' *   Convert Anim To Grey V2.0   *    
  4. ' *    Written by Chris Hodges    *
  5. ' *                               *
  6. ' *********************************
  7. '
  8. F$=Fsel$("","","Bitte w�hlen Sie das 000-Bild","der Animation aus")
  9. If F$="" Then End 
  10. F$=F$-"000"
  11. For A=Len(F$) To 1 Step -1
  12.   A$=Mid$(F$,A,1)
  13.   If A$=":" or A$="/" Then Exit 
  14. Next 
  15. A$=Mid$(F$,A+1)
  16. T$=Fsel$("",A$+"BW","Geben Sie nun den neuen","Namen der Anim ein")
  17. If T$="" Then End 
  18. Dim C(15)
  19. PIC=0 : PIC$="000" : HEL=1
  20. ST=Start(10)
  21. Poke ST+30,HEL
  22. Repeat 
  23.   Load Iff F$+PIC$,0
  24.   Wait Vbl 
  25.   WX=Screen Width
  26.   WY=Screen Height
  27.   For A=0 To 15 : Doke ST+32+A*2,Colour(A) : Next 
  28.   Doke ST+26,WX
  29.   Doke ST+28,WY
  30.   For A=0 To 5 : Loke ST+2+A*4,Logbase(A) : Next 
  31.   Limit Mouse 
  32.   Call ST
  33.   Screen Open 1,WX,WY,16,0
  34.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  35.   Screen Display 1,288-WX/2,168-WY/2,WX,WY
  36.   For A=0 To 15 : Colour A,A*$111 : Next 
  37.   Screen Copy 0 To 1
  38.   Save Iff T$+PIC$
  39.   Inc PIC
  40.   If PIC<100 Then PIC$="0" Else PIC$=""
  41.   If PIC<10 Then PIC$=PIC$+"0"
  42.   PIC$=PIC$+Mid$(Str$(PIC),2)
  43.   If Exist(F$+PIC$)=0 Then PIC$=""
  44. Until PIC$=""
  45. End 
  46. HAMCOL:
  47.   If P<16 Then C0=C(P)/256 : C1=(C(P) and $F0)/16 : C2=C(P) mod 16 : Return 
  48.   If P<32 Then C2=P-16 : Return 
  49.   If P<48 Then C0=P-32 : Return 
  50.   C1=P-48
  51. Return